home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / ag386att.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  26KB  |  758 lines
  1. {
  2.     $Id: ag386att.pas,v 1.1.1.1 1998/03/25 11:18:12 root Exp $
  3.     Copyright (c) 1996-98 by the FPC development team
  4.  
  5.     This unit implements an asmoutput class for i386 AT&T syntax
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit ag386att;
  24.  
  25.     interface
  26.  
  27.     uses aasm,assemble;
  28.  
  29.     type
  30.       pi386attasmlist=^ti386attasmlist;
  31.       ti386attasmlist = object(tasmlist)
  32.         procedure WriteTree(p:paasmoutput);virtual;
  33.         procedure WriteAsmList;virtual;
  34.       end;
  35.  
  36.   implementation
  37.  
  38.     uses
  39.       dos,globals,systems,cobjects,i386,
  40.       strings,files,verbose
  41. {$ifdef GDB}
  42.       ,gdb
  43. {$endif GDB}
  44.       ;
  45.  
  46.     const
  47.       line_length = 70;
  48.     var
  49.       infile : pextfile;
  50.       includecount,
  51.       lastline : longint;
  52.  
  53.  
  54.     function getreferencestring(const ref : treference) : string;
  55.     var
  56.       s : string;
  57.     begin
  58.       if ref.isintvalue then
  59.        s:='$'+tostr(ref.offset)
  60.       else
  61.        begin
  62.          with ref do
  63.           begin
  64.           { have we a segment prefix ? }
  65.           { These are probably not correctly handled under GAS }
  66.           { should be replaced by coding the segment override  }
  67.           { directly! - DJGPP FAQ                              }
  68.             if segment<>R_DEFAULT_SEG then
  69.              s:=att_reg2str[segment]+':'
  70.             else
  71.              s:='';
  72.             if assigned(symbol) then
  73.              s:=s+symbol^;
  74.             if offset<0 then
  75.              s:=s+tostr(offset)
  76.             else
  77.              if (offset>0) then
  78.               begin
  79.                 if assigned(symbol) then
  80.                  s:=s+'+'+tostr(offset)
  81.                 else
  82.                  s:=s+tostr(offset);
  83.               end;
  84.             if (index<>R_NO) and (base=R_NO) then
  85.              Begin
  86.                s:=s+'(,'+att_reg2str[index];
  87.                if scalefactor<>0 then
  88.                 s:=s+','+tostr(scalefactor)+')'
  89.                else
  90.                 s:=s+')';
  91.              end
  92.             else
  93.              if (index=R_NO) and (base<>R_NO) then
  94.               s:=s+'('+att_reg2str[base]+')'
  95.              else
  96.               if (index<>R_NO) and (base<>R_NO) then
  97.                Begin
  98.                  s:=s+'('+att_reg2str[base]+','+att_reg2str[index];
  99.                  if scalefactor<>0 then
  100.                   s:=s+','+tostr(scalefactor)+')'
  101.                  else
  102.                   s := s+')';
  103.                end;
  104.           end;
  105.        end;
  106.       getreferencestring:=s;
  107.     end;
  108.  
  109.     function getopstr(t : byte;o : pointer) : string;
  110.     var
  111.       hs : string;
  112.     begin
  113.       case t of
  114.         top_reg : getopstr:=att_reg2str[tregister(o)];
  115.         top_ref : getopstr:=getreferencestring(preference(o)^);
  116.       top_const : getopstr:='$'+tostr(longint(o));
  117.      top_symbol : begin
  118.                     hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  119.                     move(pchar(pcsymbol(o)^.symbol)^,hs[2],byte(hs[0]));
  120.                     inc(byte(hs[0]));
  121.                     hs[1]:='$';
  122.                     if pcsymbol(o)^.offset>0 then
  123.                      hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  124.                     else
  125.                      if pcsymbol(o)^.offset<0 then
  126.                       hs:=hs+tostr(pcsymbol(o)^.offset);
  127.                     getopstr:=hs;
  128.                   end;
  129.       else
  130.        internalerror(10001);
  131.       end;
  132.     end;
  133.  
  134.  
  135.     function getopstr_jmp(t : byte;o : pointer) : string;
  136.     var
  137.       hs : string;
  138.     begin
  139.       case t of
  140.        top_reg : getopstr_jmp:=att_reg2str[tregister(o)];
  141.        top_ref : getopstr_jmp:='*'+getreferencestring(preference(o)^);
  142.      top_const : getopstr_jmp:=tostr(longint(o));
  143.     top_symbol : begin
  144.                     hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  145.                     move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  146.                     if pcsymbol(o)^.offset>0 then
  147.                      hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  148.                     else
  149.                      if pcsymbol(o)^.offset<0 then
  150.                       hs:=hs+tostr(pcsymbol(o)^.offset);
  151.                     getopstr_jmp:=hs;
  152.                  end;
  153.       else
  154.        internalerror(10001);
  155.       end;
  156.     end;
  157.  
  158.     var
  159.       MMXWarn : boolean;
  160.     procedure MMXWarning;
  161.     begin
  162.       if not MMXWarn then
  163.        begin
  164.          Message(assem_w_mmxwarning_as_281);
  165.          MMXWarn:=true;
  166.        end;
  167.     end;
  168.  
  169.  
  170. {****************************************************************************
  171.                             TI386ATTASMOUTPUT
  172.  ****************************************************************************}
  173.  
  174. {$ifdef GDB}
  175.     var
  176.       n_line : byte;    { different types of source lines }
  177. {$endif}
  178.  
  179.     const
  180.       ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]=
  181.        (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
  182.  
  183. {$ifdef MAKELIB}
  184.  
  185.      const
  186.         nameindex : longint = 0;
  187.      var
  188.         path, filename : string;
  189.  
  190.      procedure getnextname(var filename : string);
  191.  
  192.        begin
  193.           inc(nameindex);
  194.           if nameindex>999999 then
  195.             begin
  196.                exterror:=strpnew(' too many assembler files ');
  197.                fatalerror(user_defined);
  198.             end;
  199.           filename:='as'+tostr(nameindex);
  200.        end;
  201. {$endif MAKELIB}
  202.  
  203.     procedure ti386attasmlist.WriteTree(p:paasmoutput);
  204.     type
  205.       twowords=record
  206.         word1,word2:word;
  207.       end;
  208.     var
  209.       ch       : char;
  210.       hp       : pai;
  211.       consttyp : tait;
  212.       s        : string;
  213.       found    : boolean;
  214.       i,pos,l  : longint;
  215. {$ifdef GDB}
  216.       funcname  : pchar;
  217.       linecount : longint;
  218. {$endif GDB}
  219.  
  220.     begin
  221. {$ifdef GDB}
  222.       funcname:=nil;
  223.       linecount:=1;
  224. {$endif GDB}
  225.       hp:=pai(p^.first);
  226.       while assigned(hp) do
  227.        begin
  228.        { write debugger informations }
  229. {$ifdef GDB}
  230.          if cs_debuginfo in aktswitches then
  231.           begin
  232.             if not (hp^.typ in  [ait_external,ait_stabn,ait_stabs,
  233. {$ifdef MAKELIB}
  234.                    ait_cut,
  235. {$endif MAKELIB}
  236.                    ait_stab_function_name]) then
  237.              begin
  238.                if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile)  then
  239.                 begin
  240.                   infile:=hp^.infile;
  241.                   inc(includecount);
  242.                   if (hp^.infile^.path^<>'') then
  243.                    begin
  244.                      AsmWriteLn(#9'.stabs "'+BsToSlash(FixPath(hp^.infile^.path^))+'",'+tostr(n_includefile)+
  245.                                 ',0,0,'+target_info.labelprefix+'text'+ToStr(IncludeCount));
  246.                    end;
  247.                   AsmWriteLn(#9'.stabs "'+FixFileName(hp^.infile^.name^+hp^.infile^.ext^)+'",'+tostr(n_includefile)+
  248.                              ',0,0,'+target_info.labelprefix+'text'+ToStr(IncludeCount));
  249.                   AsmWriteLn(target_info.labelprefix+'text'+ToStr(IncludeCount)+':');
  250.                 end;
  251.               { file name must be there before line number ! }
  252.                if (hp^.line<>lastline) and (hp^.line<>0) then
  253.                 begin
  254.                   if (n_line = n_textline) and assigned(funcname) and
  255.                      (target_info.use_function_relative_addresses) then
  256.                    begin
  257.                      AsmWriteLn(target_info.labelprefix+'l'+tostr(linecount)+':');
  258.                      AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
  259.                                 target_info.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
  260.                      inc(linecount);
  261.                    end
  262.